'   *****************************************

'   *******  2DFFT 14.00 - 2D XFORM   *******

'   ******* APPS 2ND EDITION - 05/03  *******

'   *****************************************



10 SCREEN 9, 1, 1: COLOR 15, 1: CLS

14 INPUT "SELECT ARRAY SIZE AS 2^N.  N ="; N

16 N1 = N - 1: Q = 2 ^ N: Q1 = Q - 1

18 ' $DYNAMIC

20 DIM C(Q, Q), S(Q, Q), KC(Q), KS(Q), DAC(Q, Q), DAS(Q, Q)

30 Q2 = Q / 2: Q3 = Q2 - 1: Q4 = Q / 4: Q5 = Q4 - 1: Q8 = Q / 8

32 PI = 3.141592653589793#: PI2 = 2 * PI: K1 = PI2 / Q: CLVK = 1

 '  **** TWIDDLE FACTOR TABLE GENERATION ****

40 FOR I = 0 TO Q: KC(I) = COS(K1 * I): KS(I) = SIN(K1 * I)

42 IF ABS(KC(I)) < .0000005 THEN KC(I) = 0 ' CLEANUP TABLE

44 IF ABS(KS(I)) < .0000005 THEN KS(I) = 0

46 NEXT I

48 FOR I = 1 TO Q1: INDX = 0

50 FOR J = 0 TO N1

52 IF I AND 2 ^ J THEN INDX = INDX + 2 ^ (N1 - J)

54 NEXT J

56 IF INDX > I THEN SWAP KC(I), KC(INDX): SWAP KS(I), KS(INDX)

58 NEXT I



70 CLS : PRINT : PRINT : PRINT "               MAIN MENU": PRINT

74 PRINT " 1 = TRANSFORM FUNCTION": PRINT

76 PRINT " 2 = INVERSE TRANSFORM ": PRINT

84 PRINT " 3 = GENERATE FUNCTIONS              ": PRINT

88 PRINT " 4 = EXIT              ": PRINT : PRINT

90 PRINT "            MAKE SELECTION";

92 A$ = INKEY$: IF A$ = "" THEN 92

94 A = VAL(A$): ON A GOSUB 100, 150, 5000, 112

96 IF A = 4 THEN 9999

98 GOTO 70



 '  **********************************************

 '  *              XFORM FUNCTION                *

 '  **********************************************

100 CLS : K6 = -1: SK1 = 2: XDIR = 1: T9 = TIMER 'XDIR: 1 = FWD, 0 = INVERSE

101 GOSUB 400 ' QUADRANT SWAP

102 GOSUB 200 ' DO FORWARD ROW XFORMS

104 GOSUB 300 ' DO FORWARD COLUMN XFORMS

105 GOSUB 400 ' QUADRANT SWAP

106 T9 = TIMER - T9 ' CHECK TIME

108 GOSUB 176 ' DISPLAY DATA

110 PRINT : INPUT "ENTER TO CONTINUE"; A$ ' WAIT

112 RETURN



 '  **********************************************

 '  *            INVERSE TRANSFORM               *

 '  **********************************************

150 CLS : K6 = 1: SK1 = 1: XDIR = 0: T9 = TIMER

151 GOSUB 400 ' QUADRANT SWAP

152 GOSUB 300 ' RECONSTRUCT COLUMNS

153 GOSUB 200 ' RECONSTRUCT ROWS

154 GOSUB 400 ' QUADRANT SWAP

155 T9 = TIMER - T9 ' GET TIME

156 GOSUB 176 ' PLOT OUTPUT

158 PRINT : INPUT "ENTER TO CONTINUE"; A$ ' WAIT

160 RETURN



 '  **********************************************

 '  *                PLOT DATA                   *

 '  **********************************************

176 CLS : AMP1 = 0 ' FIND LARGEST MAGNITUDE IN ARRAY

178     FOR I = 0 TO Q - 1

180         FOR J = 0 TO Q - 1

182              IF XDIR = 0 THEN AMP = C(I, J): GOTO 186

184              AMP = SQR(C(I, J) ^ 2 + S(I, J) ^ 2)

186              IF AMP > AMP1 THEN AMP1 = AMP

188         NEXT J

190     NEXT I

192 MAG2 = -130 / AMP1 ' SET SCALE FACTOR

194 GOSUB 6000 ' PLOT 2-D DATA

196 LOCATE 1, 1: PRINT "TIME = "; T9

198 RETURN



 '  ************************************************

 '  *              TRANSFORMS                      *

 '  ************************************************

200 CLS : KRTST = 19

202 FOR KR = 0 TO Q1 ' XFORM 2D ARRAY BY ROWS

206 PRINT USING "###_ "; KR; ' PRINT ROW BEING XFORMED

208 IF KR = KRTST THEN PRINT : KRTST = KRTST + 20' END PRINT LINE

'    ***********************************

'    * THE ROUTINE BELOW IS FOR A ROW  *

'    ***********************************

210 FOR M = 0 TO N1: QT = 2 ^ (N - M)' DO N STAGES

212 QT2 = QT / 2: QT3 = QT2 - 1: KT = 0

214 FOR J = 0 TO Q1 STEP QT: KT2 = KT + 1' DO ALL FREQUENCY SETS

216 FOR I = 0 TO QT3: J1 = I + J: K = J1 + QT2' DO ALL FREQUENCIES IN SET

    ' ROW BUTTERFLY

218 CTEMP = (C(KR, J1) + C(KR, K) * KC(KT) - K6 * S(KR, K) * KS(KT)) / SK1

220 STEMP = (S(KR, J1) + K6 * C(KR, K) * KS(KT) + S(KR, K) * KC(KT)) / SK1

222 CTEMP2 = (C(KR, J1) + C(KR, K) * KC(KT2) - K6 * S(KR, K) * KS(KT2)) / SK1

224 S(KR, K) = (S(KR, J1) + K6 * C(KR, K) * KS(KT2) + S(KR, K) * KC(KT2)) / SK1

226 C(KR, K) = CTEMP2: C(KR, J1) = CTEMP: S(KR, J1) = STEMP

228 NEXT I' ROTATE AND SUM NEXT PAIR OF COMPONENTS

230 KT = KT + 2

232 NEXT J' DO NEXT SET OF FREQUENCIES

234 NEXT M' DO NEXT STAGE

    ' BIT REVERSAL FOR ROW TRANSFORMS

236 FOR I = 1 TO Q1: INDX = 0

238 FOR J = 0 TO N1

240 IF I AND 2 ^ J THEN INDX = INDX + 2 ^ (N1 - J)

242 NEXT J

244 IF INDX > I THEN SWAP C(KR, I), C(KR, INDX): SWAP S(KR, I), S(KR, INDX)

246 NEXT I

250 NEXT KR

252 T9 = TIMER - T9: GOSUB 176' USE TO SHOW RESULTS OF ROW XFORMS

254 A$ = INKEY$: IF A$ = "" THEN 254

256 CLS : T9 = TIMER - T9: RETURN' ROW TRANSFORMS DONE



'    *************************************

'    * THE ROUTINE BELOW IS FOR COLUMNS  *

'    *************************************

300 KRTST = 19

302 FOR KR = 0 TO Q1 ' XFORM 2D ARRAY BY COLUMNS

306 PRINT USING "###_ "; KR;

308 IF KR = KRTST THEN PRINT : KRTST = KRTST + 20

310 FOR M = 0 TO N1: QT = 2 ^ (N - M)

312 QT2 = QT / 2: QT3 = QT2 - 1: KT = 0

314 FOR J = 0 TO Q1 STEP QT: KT2 = KT + 1

316 FOR I = 0 TO QT3:  J1 = I + J: K = J1 + QT2

    'COLUMN BUTTERFLYS

318 CTEMP = (C(J1, KR) + C(K, KR) * KC(KT) - K6 * S(K, KR) * KS(KT)) / SK1

320 STEMP = (S(J1, KR) + K6 * C(K, KR) * KS(KT) + S(K, KR) * KC(KT)) / SK1

322 CTEMP2 = (C(J1, KR) + C(K, KR) * KC(KT2) - K6 * S(K, KR) * KS(KT2)) / SK1

324 S(K, KR) = (S(J1, KR) + K6 * C(K, KR) * KS(KT2) + S(K, KR) * KC(KT2)) / SK1

326 C(K, KR) = CTEMP2: C(J1, KR) = CTEMP: S(J1, KR) = STEMP

328 NEXT I

330 KT = KT + 2

332 NEXT J

334 NEXT M

    'BIT REVERSAL FOR COLUMN TRANSFORMS

336 FOR I = 1 TO Q1: INDX = 0

338 FOR J = 0 TO N1

340 IF I AND 2 ^ J THEN INDX = INDX + 2 ^ (N1 - J)

342 NEXT J

344 IF INDX > I THEN SWAP C(I, KR), C(INDX, KR): SWAP S(I, KR), S(INDX, KR)

346 NEXT I

350 NEXT KR

352 IF K6 = 1 THEN XDIR = 1

354 T9 = TIMER - T9: GOSUB 176' USE TO SHOW RESULTS OF COLUMN XFORMS

356 IF K6 = 1 THEN XDIR = 0

358 A$ = INKEY$: IF A$ = "" THEN 358

360 CLS : T9 = TIMER - T9: RETURN' COLUMN TRANSFORMS DONE



' ****************************************

' *        CORRECT FOR QUADRANTS         *

' ****************************************

400 FOR I = 0 TO Q3

402   FOR J = 0 TO Q3

404     I2 = I + Q2: J2 = J + Q2

406     SWAP C(I2, J2), C(I, J): SWAP S(I2, J2), S(I, J)

410   NEXT J

412 NEXT I

420 FOR I = 0 TO Q3

422   FOR J = Q2 TO Q - 1

424     I2 = I + Q2: J2 = J - Q2

426     SWAP C(I2, J2), C(I, J): SWAP S(I2, J2), S(I, J)

430   NEXT J

432 NEXT I

434 RETURN



      '  *********************************

      '  *      GENERATE FUNCTIONS       *

      '  *********************************

5000 XDIR = 0

5001 CLS : PRINT : PRINT : PRINT "               FUNCTION MENU": PRINT

5002 PRINT " 1 = SINUSOIDAL BARS FUNCTION      2 = SINC^2 FUNCTION": PRINT

5004 PRINT " 3 = BESSEL FUNCTION               4 = BESSEL II": PRINT

5006 PRINT " 5 = CIRCULAR FUNCTION             6 = STAR FUNCTION:": PRINT

5009 PRINT " 9 = EXIT:": PRINT

5010 PRINT "            MAKE SELECTION";

5012 A$ = INKEY$: IF A$ = "" THEN 5012

5014 A = VAL(A$): ON A GOTO 5200, 5030, 5600, 5800, 5300, 5100, 5000, 5000

5016 IF A = 9 THEN RETURN

5018 GOTO 5000



      '  *********************************

      '  *       SINC^2 FUNCTION         *

      '  *********************************

5030 CLS : T1 = 0: T0 = 1

5032 INPUT "WIDTH"; WDTH1 ' INPUT FINCTION SIZE

5034 IF WDTH1 = 0 THEN WDTH1 = 1 ' ZERO INVALID

5036 SKL1 = PI2 / WDTH1: MAG1 = Q ' CALC CONSTANTS

5038 FOR I = 0 TO Q - 1 '

5040 YARG = SKL1 * (I - Q2): PRINT "*";

5042 FOR J = 0 TO Q - 1

5044 XARG = SKL1 * (J - Q2)

5046 IF YARG = 0 AND XARG = 0 THEN C(I, J) = MAG1: GOTO 5052

5048 ARG = SQR(XARG ^ 2 + YARG ^ 2)

5050 C(I, J) = MAG1 * (SIN(ARG) / ARG) ^ 2: S(I, J) = 0

5052 NEXT J

5054 NEXT I

5055 MAG2 = -130 / MAG1

5056 GOSUB 6000 ' PLOT FUNCTION

5058 INPUT A$ ' WAIT

5060 RETURN



5100  '  ********************************

      '  *            STAR              *

      '  ********************************

5102 SCREEN 9, 1, 1: CLS

5104 INPUT "INPUT LOCATION (REL. TO 0,0)"; DELX, DELY

5106 MAG1 = Q ^ 2: ANM = MAG1 * ANP

5108 FOR I = 0 TO Q - 1

5110 FOR J = 0 TO Q - 1

5112 AN = 0

5114 C(I, J) = AN: S(I, J) = AN

5116 NEXT J

5118 NEXT I

5120 'IF SEPR > Q4 THEN 5124

5122 C(Q2 - DELX, Q2 + DELY) = MAG1

5124 ' C(0, 0) = MAG1

5126 MAG2 = -140 / Q ^ 2

5128 GOSUB 176 ' DISPLAY HANDIWORK

5130 INPUT "C/R TO CONTINUE"; A$

5132 RETURN



5200 REM *********************************

     REM *      SINUSOIDAL BARS          *

     REM *********************************

5202 CLS : KRAD = PI / Q

5204 PRINT "INPUT HORIZ, VERT FREQUENCIES (MUST BE BETWEEN 1 AND"; Q2; ")";

5206 INPUT FH, FV: IF FH < 0 OR FH > Q2 THEN 5204

5208 IF FV < 0 OR FV > Q2 THEN 5204

5210 HKRAD = KRAD * FH: VKRAD = KRAD * FV

5212 FOR I = 0 TO Q1

5214 FOR J = 0 TO Q1

5216 C(Q1 - I, J) = SIN(VKRAD * J - HKRAD * I) ^ 2: S(I, J) = 0

5224 NEXT J

5226 NEXT I

5228 MAG2 = -100: GOSUB 6000' DISPLAY FUNCTION

5230 INPUT A$  ' WAIT USER INPUT

5232 RETURN



5300  '  *********************************

      '  *         CIRC FUNCTION         *

      '  *********************************

5302 CLS : MAG1 = Q

5304 INPUT "DIAMETER"; DIA1

5306 INPUT "CENTERED ON (X,Y)"; CNTRX, CNTRY

5308 SKL1 = Q / DIA1: MAG1 = Q

5310 FOR I = 0 TO Q - 1

5312 YARG = I - CNTRY: PRINT "*";

5314 FOR J = 0 TO Q - 1

5316 XARG = J - CNTRX

5318 C(I, J) = 0:

5320 ARG = SQR(XARG ^ 2 + YARG ^ 2)

5322 IF ARG <= DIA1 THEN C(I, J) = MAG1: S(I, J) = 0

5324 NEXT J

5326 NEXT I

5328 GOSUB 176

5330 INPUT A$

5332 RETURN



      '  *********************************

      '  *       BESSEL FUNCTION         *

      '  *********************************

5600 CLS : DEFDBL D-K

5602 T0 = 1: T1 = 0

5604 INPUT "WIDTH"; WDTH1

5606 IF WDTH1 < 1 THEN 5604 ' MINIMUM WIDTH

5608 SKL1 = PI / (3.6 * WDTH1 * Q / 64)

5610 FOR I = 0 TO Q - 1

5612 YARG = SKL1 * (I - Q2): PRINT "*";

5614 FOR J = 0 TO Q - 1

5616 XARG = SKL1 * (J - Q2)

5618 KARG = SQR(XARG ^ 2 + YARG ^ 2)

5620 KA = 1: KB = 1: DAT1 = 1: KTGL = 1

5622 FOR K = 2 TO 900 STEP 2

5624 KTGL = -1 * KTGL

5626 KA = KA * K: KB = KB * (K + 2): DENOM = KA * KB

5628 DAT2 = KTGL * (WDTH1 ^ (K / 2) * KARG ^ K / DENOM)

5630 IF ABS(DAT2) < ABS(DAT1) * 1E-10 THEN 5640

5632 DAT1 = DAT1 + DAT2

5634  '  PRINT DAT1,

5636 NEXT K

5638 PRINT "#"

5640 C(I, J) = DAT1: S(I, J) = 0

5642 NEXT J

5644 NEXT I

5646 GOSUB 176

5648 INPUT A$

5650 RETURN



     REM *********************************

     REM *     BESSEL FUNCTION II        *

     REM *********************************

5800 CLS

5802 MAG1 = Q: M3 = 1: KR = PI2 / Q: MAG2 = -130

5804 FOR I = 0 TO Q: FOR J = 0 TO Q: C(I, J) = 0: S(I, J) = 0: NEXT: NEXT

5806 INPUT "WIDTH"; WDH

5808 FOR A = 0 TO WDH: IF A = 0 THEN M2 = M3 / 2 ELSE M2 = M3

5810 FOR B = 0 TO SQR(WDH ^ 2 - A ^ 2): IF B = 0 THEN M1 = M2 / 2 ELSE M1 = M2

5812 FOR I = 0 TO Q1: I2 = A * (I - Q2)

5814 FOR J = 0 TO Q1: J2 = B * (J - Q2)

5816 C(I, J) = C(I, J) + M1 * (COS(KR * (I2 - J2)) + COS(KR * (I2 + J2)))

5818 NEXT J

5820 NEXT I

5822 'GOSUB 176

5824 NEXT B

GOSUB 176

5826 NEXT A

5828 GOSUB 176

5830 INPUT A$

5832 RETURN



6000  '  *******************************

      '  *         PLOT DATA           *

      '  *******************************

6002 CLS ' CLEAR SCREEN AND SET SCALE FACTORS

6004 XCAL = 320 / Q: YCAL = 120 / Q: YDIS = 150: X0 = 15

6006 FOR I = 0 TO Q - 1 ' FOR ALL ROWS

6008 DISP = X0 + (Q - I) * 288 / Q ' DISPLACE ROWS FOR 3/4 VIEW

6010 PER = I / (2 * Q) ' CORRECT FOR PERSPECTIVE

6012 FOR J = 0 TO Q - 1 ' FOR EACH PIXEL IN ROW

6014 X11 = ((XCAL + PER) * J) + DISP: Y11 = ((YCAL + .3 * PER) * I) + YDIS

6016 IF XDIR = 0 THEN AMP = C(I, J) ELSE AMP = SQR(C(I, J) ^ 2 + S(I, J) ^ 2)   ' CALC "Z" AXIS

6018 AMP = MAG2 * AMP

6020 LINE (X11, Y11 + AMP)-(X11, Y11)

6022 PRESET (X11, Y11 + AMP + 1)

6024 NEXT J ' NEXT PIXEL

6026 NEXT I ' NEXT ROW

6028 RETURN ' ALL DONE

     ' ***************

9999 END: STOP



